home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / SystemCode / shell.tcl < prev    next >
Encoding:
Text File  |  1994-09-21  |  12.7 KB  |  517 lines  |  [TEXT/ALFA]
  1.  
  2. ################################################################################
  3. # Shell routines.
  4. ################################################################################
  5.  
  6.  
  7. proc setShellMode {} {
  8.     setTclMode
  9.     changeMode "Csh"
  10.     insertMenu "Tcl"
  11. }
  12.  
  13. proc initShell {} {
  14.     insertText "Welcome to Alpha's Tcl shell."
  15.     insertText -w [lindex [winNames] 0] [shellPrompt]
  16. }
  17.  
  18. # Return the prompt. We want the window name because some of the commands
  19. # we evaluate (such as 'edit') open a new window, and we want the insertion
  20. # to be done in the shell window.
  21. proc shellPrompt {} {
  22.     regexp "(\[^:\]*):$" [pwd] crDum crDir
  23.     return "\r«$crDir» "
  24. }
  25.  
  26.  
  27. # Called at all carriage returns.
  28. proc carriageReturn {} {
  29.     global mode
  30.     global indentOnCR
  31.     set indentString ""
  32.     deleteText [getPos] [selEnd]
  33.     if {$indentOnCR} {
  34.         set pos [getPos]
  35.         set text [getText [lineStart $pos] $pos]
  36.         for {set i 0; set len [string length $text]} {$i <= $len} {incr i} {
  37.             set c [string index $text $i]
  38.             if {($c != "\t") && ($c != "\ ")} {
  39.                 set indentString [string range $text 0 [expr $i-1]]
  40.                 break
  41.             }
  42.         }
  43.     }
  44.     insertText "\r" $indentString
  45. }
  46.  
  47.  
  48. proc tclCarriageReturn {} {
  49.     global mode histnum
  50.     global _text
  51.     global _returnText
  52.     set pos [getPos]
  53.  
  54.     if {![catch {regexp {∞} [getText $pos [nextLineStart $pos]]} res] && $res} {
  55.         gotoMatch; return;
  56.     }
  57.     set ind [string first "»" [getText [lineStart $pos] $pos]]
  58.     if {$ind < 0} {
  59.         carriageReturn
  60.         return
  61.     }
  62.     set lStart [expr [lineStart $pos]+$ind+2]
  63.     endOfLine
  64.     set _text [getText $lStart [getPos]]
  65.     set fileName [lindex [winNames] 0]
  66.     if {[getPos] != [maxPos]} {
  67.         goto [maxPos]
  68.         insertText -w $fileName $_text
  69.     }
  70.     if {[string first "Toolserver" $fileName] != -1} {
  71.         if {![catch {dosc -n ToolServer -s $_text} _returnText]} {
  72.             insertText "\r" $_returnText
  73.         } else {
  74.             insertText "\r"
  75.         }
  76.         mpwPrompt
  77.     } else {
  78.         uplevel #0 {catch $_text _returnText}
  79.         history add $_text
  80.         if {[string length $_returnText]} {
  81.             insertText -w $fileName "\r" $_returnText [shellPrompt]
  82.         } else {
  83.             insertText -w $fileName [shellPrompt]
  84.         }
  85.         set histnum [history nextid]
  86.     }
  87.     unset _text
  88.     unset _returnText
  89. }
  90. bind '\r' carriageReturn
  91. bind '\r' tclCarriageReturn "Csh"
  92. bind '\r' tclCarriageReturn "MPW"
  93.  
  94.  
  95. bind up <z> prevHist Csh
  96. bind down <z> nextHist Csh
  97.  
  98. proc prevHist {} {
  99.     global histnum
  100.     
  101.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  102.     if {[set ind [string first "» " $text]] > 0} {
  103.         goto [expr [lineStart [getPos]] + $ind + 2]
  104.     } else return
  105.  
  106.     incr histnum -1
  107.     if {[catch {history event $histnum} text]} {
  108.         incr histnum
  109.         endOfLine
  110.         return
  111.     }
  112.     set to [nextLineStart [getPos]]
  113.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  114.     replaceText [getPos] $to $text
  115. }
  116.  
  117.  
  118. proc nextHist {} {
  119.     global histnum
  120.     
  121.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  122.     if {[set ind [string first "» " $text]] > 0} {
  123.         goto [expr [lineStart [getPos]] + $ind + 2]
  124.     } else return
  125.  
  126.     incr histnum
  127.     if {[catch {history event $histnum} text]} {
  128.         incr histnum -1
  129.         endOfLine
  130.         return
  131.     }
  132.     set to [nextLineStart [getPos]]
  133.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  134.     replaceText [getPos] $to $text
  135. }
  136.  
  137.     
  138. proc startMPW {} {
  139.     global toolserverPath
  140.  
  141.     if {![string length [checkRunning ToolServer MPSX toolserverPath]]} return
  142.  
  143.     insertText "Welcome to Alpha's MPW shell (using ToolServer via AppleEvents)."
  144.     bind '\r' tclCarriageReturn "MPW"
  145.     carriageReturn
  146.     mpwPrompt
  147. }
  148. proc mpwPrompt {} {
  149.     insertText "«mpw» "
  150. }
  151.  
  152. proc setMPWMode {} {
  153.     changeMode "MPW"
  154. }
  155.  
  156. #    tclCarriageReturn
  157.  
  158.  
  159.  
  160. #=============================================================================
  161. #    Shell Aliases
  162. #=============================================================================
  163.  
  164.  
  165. proc l {args} {
  166.     eval [concat "ls -CF" $args]}
  167.  
  168. proc ll {args} {
  169.     eval [concat "ls -l" $args]}
  170.  
  171.  
  172. proc wc {args} {
  173.     set totChars 0
  174.     set totLines 0
  175.     set totWords 0
  176.     set args [glob -nocomplain $args]
  177.     foreach file $args {
  178.         set id [open $file]
  179.         set chars [string length [set text [read $id]]]
  180.         set lines [llength [split $text "\n"]]
  181.         set words [llength [split $text]]
  182.         insertText [format "\r%8d%8d%8d    $file" $lines $words $chars]
  183.         set totChars [expr $totChars+$chars]
  184.         set totWords [expr $totWords+$words]
  185.         set totLines [expr $totLines+$lines]
  186.         close $id
  187.     }
  188.     if {[llength $args] > 1} {
  189.         insertText [format "\r%8d%8d%8d    total" $totLines $totWords $totChars]
  190.     }
  191. }
  192.  
  193. ###########################################################################
  194. #  better-cp-mv.tcl  -- modification of your routines, by Mark Nagata
  195. #  for Alpha 5.72,  1/04/94
  196. ###########################################################################
  197. proc cp args {
  198.     if {[set len [llength $args]] < 2} {
  199.         error "usage: cp <file1> <file2>\r       cp <file1> .... <dir>"
  200.     }
  201.     set len [expr $len-1]
  202.     set dir [lindex $args $len]
  203.     if {![regexp {:} $dir] && $dir != ""} {
  204.         set dir ":$dir"
  205.     }
  206.     if {[regexp {:$} $dir]} {
  207.         set dir [string trimright $dir {:}]
  208.     }
  209.     set args [lreplace $args $len $len]
  210.     set files {}
  211.     foreach arg $args {
  212.         append files " " [glob $arg]
  213.     }
  214.     set report ""
  215.     if {[llength $files] == 1} {
  216.         set f [lindex $files 0]
  217.         if {[file exists $dir]} {
  218.             set targ $dir:[file tail $f]
  219.             append report $f\ ->\ $targ \r 
  220.             copyFile $f $targ
  221.         } else {
  222.             append report $f\ ->\ $dir \r
  223.             copyFile $f $dir
  224.         }
  225.     } else {
  226.         foreach f $files {
  227.             message [file tail $f]
  228.             set targ $dir:[file tail $f]
  229.             append report $f\ ->\ $targ \r
  230.             if {[catch {copyFile $f $targ} that]} {
  231.                 alertnote "Error copying '$f' -> '$targ': $that"
  232.             }
  233.         }
  234.     }
  235.     echo [string trimright $report]
  236. }
  237.  
  238. proc mv args {
  239.     if {[set len [llength $args]] < 2} {
  240.         error "usage: mv <file1> <file2>\r       mv <file1> .... <dir>"
  241.     }
  242.     set len [expr $len-1]
  243.     if {![regexp {.*[^:]} [lindex $args $len] dir]} {
  244.         set dir [string range [lindex $args $len] 1 end]
  245.     }
  246.     if {![regexp {:} $dir] && $dir != ""} {
  247.         set dir [concat :$dir]}
  248.     set args [lreplace $args $len $len]
  249.     set files {}
  250.     foreach arg $args {
  251.         append files " " [glob $arg]
  252.     }
  253.     set report ""
  254.     if {[llength $files] == 1} {
  255.         set f [lindex $files 0]
  256.         if {[file exists $dir]} {
  257.             set targ $dir:[file tail $f]
  258.             append report $f\ >->\ $targ \r
  259.             moveFile $f $targ
  260.         } else {
  261.             append report $f\ >->\ $dir \r
  262.             moveFile $f $dir
  263.         }
  264.     } else {
  265.         foreach f $files {
  266.             message [file tail $f]
  267.             set targ $dir:[file tail $f]
  268.             append report $f\ >->\ $targ \r
  269.             if {[catch {moveFile $f $targ} that]} {
  270.                 alertnote "Error moving '$f' -> '$targ': $that"
  271.             }
  272.         }
  273.     }
  274.     echo [string trimright $report]
  275. }
  276.  
  277.  
  278. proc rm args {
  279.     set files {}
  280.     foreach arg $args {
  281.         append files " " [glob $arg]
  282.     }
  283.     foreach f $files {
  284.         message [file tail $f]
  285.         removeFile $f
  286.     }
  287. }
  288.  
  289.  
  290.  
  291.  
  292. #================================================================================
  293.  
  294.  
  295. proc tclFileCompletion {} {
  296.     set silly "*"
  297.     set pos [getPos]
  298.     set res [search -f 0 -i 0 -m 0 -r 1 -n {["\{ \t\r]} [expr $pos - 1]]
  299.     if {[string length $res]} {
  300.         set from [lindex $res 1]
  301.         if {$from < $pos} {
  302.             set pd [pwd]
  303.             set text [getText $from $pos]
  304.             if {[string index $text 0] == ":"} {
  305.                 set pd [string trimright $pd ":"]
  306.             }
  307.             if {[catch {glob $pd$text$silly} globbed]} {
  308.                 set globbed [glob $text$silly]
  309.                 set pd ""
  310.             }
  311.             if {[llength $globbed] == 1} {
  312.                 set len [string length $pd$text]
  313.                 insertText [string range [lindex $globbed 0] $len end]
  314.             } elseif {[llength $globbed] != 0} {
  315.                 set globbed [lsort $globbed]
  316.                 set one [lindex $globbed 0]
  317.                 set two [lindex $globbed end]
  318.                 
  319.                 set len [string length $pd$text]
  320.                 set one [string range $one $len end]
  321.                 set two [string range $two $len end]
  322.                 
  323.                 set elen [string length $one]
  324.                 if {[string length $two] < $elen} {
  325.                     set elen [string length $two]
  326.                 }
  327.                 set len 0
  328.                 set str ""
  329.                 while {($len < $elen) && ([string match $str[string index $one $len]$silly $two])} {
  330.                     append str [string index $one $len]
  331.                     incr len
  332.                 }
  333.  
  334.                 if {!$len} {
  335.                     set elen [string length $pd]
  336.                     foreach g $globbed {
  337.                         lappend short [string range $g $elen end]
  338.                     }
  339.                     set blah [getText [lineStart [getPos]] [getPos]]
  340.                     insertText "\r" $short "\r" $blah
  341.                 } else {
  342.                     insertText $str
  343.                 }
  344.             }
  345.         }
  346.     }
  347. }
  348.  
  349.  
  350.  
  351. #================================================================================
  352. # To prevent ambiguity, 'from' is assumed to be a complete pathname, ending
  353. # in a directory name. If it doesn't end w/ a colon, one is added. 'to' is
  354. # assumed to be the parent directory of the top directory we are creating.
  355. #================================================================================
  356. proc cpdir {from to} {
  357.     set cwd [pwd]
  358.     if {[string match ":*" $from] || [string match ":*" $to] ||
  359.         ![file exists $from] || ![file exists $to]} {
  360.         error "'cpdir' args must be complete pathnames of existing folders."
  361.     }
  362.     if {![string match "*:" $from]} {append from ":"}
  363.     if {![string match "*:" $to]} {append to ":"}
  364.     
  365.     if {![file isdir $from] || ![file isdir $to]} {
  366.         exit 1
  367.     }
  368.         
  369.     set res [catch {cphier $from $to} val]
  370.     cd $cwd
  371.     if {$res} {error $val}
  372. }
  373.  
  374. proc cphier {from to} {
  375.     set savedir [pwd]
  376.     if {[string index $from [expr [string len $from] - 1]] != ":"} {append from ":"}
  377.     set dir [file tail [string trimright $from ":"]]
  378.     cd $to
  379.     mkdir "$dir"
  380.     foreach f [glob "$from*"] {
  381.         if {[file isdir $f]} {
  382.             cphier "$f:" "$to$dir:"
  383.         } else {
  384.             cp $f $to$dir:
  385.         }
  386.     }
  387.     cd $savedir
  388. }
  389.  
  390.  
  391. if {![string length [info commands oldMkdir]]} {
  392.     rename mkdir oldMkdir
  393.     rename rmdir oldRmdir
  394. }
  395.  
  396. proc mkdir {dir} {
  397.     oldMkdir [list $dir]
  398. }
  399.  
  400. proc rmdir {dir} {
  401.     oldRmdir [list $dir]
  402. }
  403.  
  404. proc shellBol {} {
  405.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  406.     if {[set ind [string first "» " $text]] > 0} {
  407.         goto [expr [lineStart [getPos]] + $ind + 2]
  408.     } else {
  409.         goto [lineStart [getPos]]
  410.     }
  411. }
  412. bind 'a' <z> shellBol Csh
  413.  
  414.  
  415. proc dummyCsh {} {}
  416.  
  417. #================================================================================
  418.  
  419. proc shellup {} {
  420.     set pos [expr [lineStart [getPos]] - 1]
  421.     if {[catch {regexp {∞} [getText [lineStart $pos] [nextLineStart $pos]]} res] || !$res} {
  422.         previousLine; return
  423.     }
  424.     select [lineStart $pos] [nextLineStart $pos]
  425. }
  426. bind up shellup Csh
  427.  
  428.  
  429. proc shelldown {} {
  430.     set pos [nextLineStart [getPos]]
  431.     if {[catch {regexp {∞} [getText $pos [nextLineStart $pos]]} res] || !$res} {
  432.         nextLine; return
  433.     }
  434.     select $pos [nextLineStart $pos]
  435. }
  436. bind down shelldown Csh
  437.  
  438.         
  439. #================================================================================
  440. proc sortdt {dt} {
  441.     scan $dt "%d/%d/%d {%d:%d:%d %1sM}" mon day yea hou min sec z
  442.     if {$z == "P"} {incr hou 12}
  443.     return [format "%02d%02d%02d%02d%02d" $yea $mon $day $hou $min]
  444. }
  445.  
  446.  
  447. proc lt args {
  448.     set val "*"
  449.     set sort 1
  450.     scan [lindex [date] 0] "%d/%d/%d" one two three
  451.     set year 19$three
  452.     
  453.     foreach arg $args {
  454.         switch -- $arg {
  455.             "-t"     {set sort 0}
  456.             default    {set val $arg}
  457.         }
  458.     }
  459.     set mod ""
  460.     foreach f [eval glob $val] {
  461.         if {[catch {getFileInfo $f info}]} {
  462.             if {$sort} {set mod "0000000000 "}
  463.             lappend text [format "%s%s %8d%8d %6s %5s %4s %s %s\n" $mod "D" "0" "0" "" "" "" "DIR " [file tail $f]]
  464.             continue
  465.         }
  466.         if {$sort} {set mod "[sortdt [mtime $info(modified) s]] "}
  467.         set m [mtime $info(modified) a]
  468.         set zer [lindex $m 0]
  469.         set dat [format "%s %2s" [lindex $zer 1] [string trimright [lindex $zer 2] {,}]]
  470.         if {[lindex $zer 3] == $year} {
  471.             if {[scan [lindex $m 1] "%d:%d:%d %s" one two three am] != 4} {
  472.                 error "Didn't get four from scan"
  473.             }
  474.             if {[string length $two] == 1} {set two "0$two"}
  475.             set tm [expr {$am == "AM"} ? $one : [expr $one + 12]]:$two
  476.         } else {
  477.             set tm " [lindex $zer 3]"
  478.         }
  479.         lappend text [format "%sF %8d%8d %s %5s %s %s %s\n" $mod $info(datalen) $info(resourcelen) $dat $tm $info(creator) $info(type) [file tail $f]]
  480.     }
  481.     if {$sort} {
  482.         foreach ln [lsort -de $text] {
  483.             append txt [string range $ln 11 end]
  484.         }
  485.         return [string trimright $txt]
  486.     } else {
  487.         return [string trimright [join $text {}]]
  488.     }
  489. }
  490.  
  491. #================================================================================
  492. proc ps {} {
  493.     foreach p [processes] {
  494.         append text [format "%-25s %4s %10d %10d\r" [lindex $p 0] [lindex $p 1] [lindex $p 2] [lindex $p 3]]
  495.     }
  496.     return [string trimright $text]
  497. }
  498.  
  499.  
  500. #================================================================================
  501. # Recursively make creator of all text files 'ALFA'. Optionally takes a starting
  502. # dir argument, otherwise starts in current directory.
  503. proc creator {{dir ":"}}  {
  504.     if {![catch {glob -t TEXT $dir*} files]} {
  505.         foreach f $files {
  506.             message $f
  507.             setFileInfo $f creator ALFA
  508.         }
  509.     }
  510.  
  511.     if {![catch {glob $dir*} dirs]} {
  512.         foreach d $dirs {
  513.             if {[file isdir $d]} {creator $d:}
  514.         }
  515.     }
  516. }
  517.